-- Try to execute the instruction i.  Some conditions to check:
-- - i's inputs have to be at the front of the queue
-- - i can't consume an input if it's the last copy in the queue and
--   more instructions need that value
-- - Note: This function should only be called if all of i's
--   predecessors have executed already.
-- - It returns a new queue and DFG that reflect the execution of i,
--   and a bucket of newly ready instructions.  Specifically:
--   - i is removed from the DFG
--   - Check input nets.  Decrement in-queue count and pending consumers
--     If pending consumers goes to zero, remove the net.
--   - Check output nets.  Increment the in-queue count.
--   - Check consumers of i's outputs to see if any is ready to execute
--   - Add the outputs to the queue.
try_instr :: G.DynGraph gr => Int -> IntSeq -> (gr DfgNInfo DfgEInfo) ->
                (Maybe (IntSeq, gr DfgNInfo DfgEInfo, IntSeq))
try_instr instr the_q_orig dfg_orig = outs_produced
  where
    dfg_orig_viz = G.graphviz' dfg_orig
    outs_produced =
      fmap produce_succs
        (fmap consume_non_regs
           (foldl' consume_reg (Just (the_q_orig, dfg_no_i)) reg_ins) )
    -- XXX: assert that i_info is a regular instruction
    (p_instr, i_info, s_instr, dfg_no_i) =
        case g_unsafe_match ("missing instruction. "++show instr++"\n"++dfg_orig_viz) instr dfg_orig of
          ((p,_,DfgOp asminfo,s),g) -> (p,asminfo,s,g)
          ((_,_,ii,_),_) -> error ("wrong instr!!! "++show instr++"  " ++ show ii )
    (reg_ins, other_ins) =
      partition ((<dfg_reg_port_lim) . fst) $ sortBy (comparing fst) (ports p_instr)
    -- Step 1: Consume the register predecessors
    consume_reg Nothing _ = Nothing
    consume_reg (Just (q,dfg)) (_,reg_p) =
      let dfg_viz = G.graphviz' dfg
          (front, q_rest) = case Q.viewl q of
            Q.EmptyL -> error ("empty queue? screw you " ++ show (length reg_ins) ++ " "
                                     ++ show i_info ++ "  \n" ++ G.graphviz' dfg)
            x :< y -> (x, y)
          q_count_r = 42 -- XXX
          c_count_r = 42 -- XXX
          (p_r, name_r, s_r, dfg_r) =
              g_unsafe_match_net "no net? 1screw you" reg_p dfg
          -- The following chunk of code is only relevant for actual/formal stuff
          q_count_f = 42 -- XXX
          c_count_f = 42 -- XXX
          (p_f, name_f, _, dfg_f) =
              g_unsafe_match_net ("front missing; formal LI? "++show front++"\n"++dfg_viz) front dfg_r
          hub_id = case p_r of
                     [(_,h)] -> assert (h == live_in_hub_id) h
                     _ -> error "i just want the hub"
          ((p_h,_,_,s_h),_) = g_unsafe_match "hub 2exist!" hub_id dfg_f
          g_actuals =
              filter (\(_,p) ->
                          let (ps,_,_,_) = g_unsafe_match_net "err 344" p dfg_f in
                          length ps <= q_count_f) --XXX length?
                     p_h
          g_formals =
              filter (\(_,s) ->
                          let (_,_,ss,_) = g_unsafe_match_net "err 345" s dfg_f in
                          length ss <= q_count_f) --XXX length?
                     s_h
          wrong_one_cond = length g_formals <= length g_actuals
      in
      -- not the right producer
      if front /= reg_p then
        if q_count_r < 0 && c_count_f < 0 && q_count_f <= c_count_r
               && (c_count_r < 2 || q_count_f > 1) && wrong_one_cond then
          -- XXX: Could assert that there's one output edge ...
          -- This is sort of a clever trick where we fix up the queue
          -- and DFG so that the previously unassigned live-in ('front')
          -- is now assigned to 'reg_p'
          consume_reg
            (Just (fmap (\i -> if i == front then reg_p else i) q,
                   ([], reg_p, DfgNet name_r, s_r)
                     &((p_f, front, DfgNet name_f, [])&dfg_f)))
            (-1,reg_p)
        else
          Nothing
      -- Okay, now we know front == reg_p ...
      -- If multiple consumers remain ...
      else if c_count_r > 1 then
        if q_count_r < 2 then
          Nothing
        else
          Just(q_rest, (p_r,reg_p,DfgNet name_r,s_r)&dfg_r)
      else
        Just(q_rest, dfg_r)
    -- Step 2: Remove non-register predecessors, as appropriate
    consume_non_regs (q_regs, dfg_regs) =
      foldl' consume_non_reg (q_regs, dfg_regs) other_ins
      where
        consume_non_reg (q,dfg) (_,non_p) =
          let (p_non, name, s_non, dfg_oi) =
                g_unsafe_match_net "no other net? screw you" non_p dfg in
          if length s_non > 1 then -- XXX length?
            (q, (p_non, non_p, DfgNet name, s_non)&dfg_oi)
          else
            (q, dfg_oi)
    -- Step 3: Push outputs into the queue, increase counts on output
    -- nets and find newly ready instructions
    produce_succs (q_no_ins, dfg_no_ins) =
      (q_with_outs, dfg_with_outs,
       Q.fromList( S.toList( S.filter is_ready possibly_ready) ) )
      where
        (q_with_outs,dfg_with_outs,possibly_ready) =
          foldl' produce_succ (q_no_ins, dfg_no_ins, S.empty)
                 (sortBy (comparing fst) (ports s_instr))
        produce_succ (q, dfg, consumers) (port, both_s) =
          ( if port < dfg_reg_port_lim then q |> both_s else q,
            (p_s, both_s, DfgNet name, s_s)&dfg_o,
            S.fromList(map snd s_s) `S.union` consumers )
            where
              (p_s, name, s_s, dfg_o) =
                g_unsafe_match_net "no out net? screw you" both_s dfg
        is_ready consumer = all producers_scheduled p_c
          where
            ((p_c,_,_,_),g_noc) = g_unsafe_match "foo you consumer" consumer dfg_with_outs
            producers_scheduled (_,n) =
              case g_unsafe_match "consumer netted" n g_noc of
                (([],_,_,_),_) -> True
                -- The next case handles un-assigned live-ins
                (([_],_,DfgNet _,_),_) -> True -- q_count_p < 0
                -- XXX: Could check for more internal errors here
                _ -> False


-- sched_that_shit takes a DFG and produces a schedule.  It tries all
-- possible schedules with iterative deepening on the number of queue
-- management instructions allowed.  It's scalability is very poor; it
-- generally tops out at DFGs with 5-10 instructions.  This makes it
-- impractical for the Quoroboros experiments.
sched_that_shit :: Dfg -> ([Int], Int)
sched_that_shit dfg_orig = raise_the_bar 0
  where
    -- Build a queue full of live-ins and instructions that don't depend on anything else
    initialize_scheduling :: Dfg -> (Q.Seq G.Node, Q.Seq G.Node)
    initialize_scheduling dfg =
        foldl' add_instrs_and_lis (Q.empty, Q.empty) (G.labNodes dfg)
            where
              add_instrs_and_lis (instrs,live_ins) (n, DfgNet _) = -- XXX | c_count < 0 =
                  (instrs, n <| live_ins)
              add_instrs_and_lis (instrs,live_ins) (i, DfgOp _) =
                  case G.pre dfg i of
                    [] -> (i <| instrs,live_ins)
                    preds ->
                        if all is_const_like preds then
                            (i <| instrs,live_ins)
                        else
                            (instrs,live_ins)
              add_instrs_and_lis (instrs,live_ins) _ = (instrs,live_ins)
              is_const_like n =
                  case g_unsafe_match "the const pred" n dfg of
                    ((_,_,DfgNet _,_),_) -> True -- XXX q_count < 0
                    ((_,_,_,_),_) -> False
    (ready_init, q_init) = initialize_scheduling dfg_orig
    -- lim is referred to in idastar
    raise_the_bar :: Int -> ([Int], Int)
    raise_the_bar lim =
      let
        idastar :: G.DynGraph gr => Int -> [Int] -> IntSeq -> IntSeq -> IntSeq ->
                   (gr DfgNInfo DfgEInfo) -> Q.Seq( [Int] )
        idastar cost sched the_q ready_ns tried_ns dfg_c =
          case (cost > lim, Q.viewl ready_ns, Q.null tried_ns, Q.viewl the_q) of
            -- If over the cost limit, fail immediately
            (True, _, _, _) -> Q.empty
            -- No instructions left to schedule.  We win!
            (_, Q.EmptyL, True, _) -> Q.singleton sched
            -- Try making ready_n the next instruction in the schedule
            (_, ready_n :< ready_ns_rest, _, _) ->
              case try_instr ready_n the_q dfg_c of
                Nothing -> skip_this_one
                Just( q_next, dfg', newly_ready ) ->
                    -- T.trace ("instr worked! "++show(ready_n:sched)++"  rnr:"++show ready_ns_rest++"  tried:"++show tried_ns++"  new:"++show newly_ready)
                            (skip_this_one ><
                             idastar cost (ready_n:sched) q_next
                                     (ready_ns_rest >< tried_ns >< newly_ready) Q.empty dfg')
              where
                skip_this_one =
                  idastar cost sched the_q ready_ns_rest (ready_n <| tried_ns) dfg_c
            -- End of the real instructions.  ready_ns must be empty at this point.
            -- Try pass, dup, swap, drop
            (_, _, _, Q.EmptyL) -> Q.empty
            (_, _, _, front :< q_rest) -> pass_next >< dup_next >< swap_next >< drop_next
              where
                -- pass and swap we can just try unconditionally
                pass_next = idastar (cost + 1) (gpass_id:sched) (q_rest |> front) tried_ns
                            Q.empty dfg_c
                swap_next =
                    case Q.viewl q_rest of
                      Q.EmptyL -> Q.empty
                      front2 :< q_rest2 ->
                          idastar (cost + 1) (gswap_id:sched) (q_rest2 |> front2 |> front)
                                  tried_ns Q.empty dfg_c
                -- dup and drop can break invariants, so we need to be more careful
                (dup_next, drop_next) =
                    let (ps, name, ss, dfg_no_front) =
                            g_unsafe_match_net ("bad Q front "++show front++"\n"++G.graphviz' dfg_c)
                                               front dfg_c
                        -- XXX: If we have other fanout support, dup should cost
                        do_dup =
                            idastar cost (gdup_id:sched) (q_rest |> front |> front) tried_ns Q.empty
                                    ((ps,front,DfgNet name,ss)&dfg_no_front)
                        -- XXX: If we have other ignoring support, drop should cost
                        do_drop = idastar cost (gdrop_id:sched) q_rest tried_ns Q.empty dfg_no_front
                    in
                    -- Note: c_count < 0 => front is an unresolved actual param
                    if length ps < 2 then -- XXX c_count < 0 then
                        let
                            hub_id = case ss of
                                       [(_,h)] | h == live_in_hub_id -> h
                                       [(_,h)] | h == live_out_hub_id ->
                                                   error ("don't know about LO yet "++show (DfgNet name))
                                       _ -> error ("i just want the hub "++show ss)
                            ((p_h,_,_,s_h),_) = g_unsafe_match "hub exist!" hub_id dfg_c
                            drop_li = if length p_h > length s_h then -- XXX && q_count < 2 then
                                          do_drop
                                      else
                                          Q.empty
                            -- g_actuals =
                            --     filter (\(_,p) ->
                            --                 let (_,_,q,_,_,_) =
                            --                         g_unsafe_match_net "err 344" p dfg_c in q > q_count)
                            --            p_h
                            -- g_formals =
                            --     filter (\(_,s) ->
                            --                 let (_,_,_,c,_,_) =
                            --                         g_unsafe_match_net "err 345" s dfg_c in c > q_count)
                            --            s_h
                            -- dup_li = if length g_formals > length g_actuals then
                            --              do_dup
                            --          else
                            --              Q.empty
                        in
                          (drop_li, drop_li) -- (dup_li, drop_li)
                    -- else if c_count < q_count then
                    --     -- Note: We should never get more copies in the queue than are needed
                    --     assert (c_count == 0 && q_count == 1) (Q.empty, do_drop)
                    -- else if q_count < c_count then
                    --     (do_dup, Q.empty )
                    else
                        (Q.empty, Q.empty)
      in
      case Q.viewl $ idastar 0 [] q_init ready_init Q.empty dfg_orig of
        -- XXX: don't just take the first schedule
        (x :< _) -> (x, lim)
        -- XXX: total hack warning on the lim limit
        Q.EmptyL -> T.trace ("raise lim "++show lim)
                            (if lim > 10 then ([],-1) else raise_the_bar (lim + 1))
